BBS in a Box 3/BBS in a box - Trilogy III.iso/Files/Tele/Pete Johnson/TImport 2.0.3<source> Folder/HelloTabby.p

Text File | 1992-02-23 | 15.3 KB | 453 lines | [TEXT/PJMM]

unit HelloTabby;

{     Written by Pete Johnson                                                                                    }
{    Enhancements by Mike Taylor                                                                            }

{    Version 1.1 of Feb. 22, 1992 -- adds new log utilities by Mike Taylor                }

{    Version 1.0 released June 22, 1991 -- first version number assigned                }

{ Source for a Think Pascal unit which handles the Tabby launch.next file,                }
{ returns the name of the next application to launch in a variable called                    }
{ NextLaunch and allows MultiFinder some cycles if the Tabby Setup file                    }
{ says Multifinder is running.                                                                                    }

{            ********** History **********                                                    }

{ Modified Mar. 11, 1989, to handle up to 100 events of < 32 chars apiece.            }
{ Modified Apr. 17 and May 6, 1989, to handle MultiFinder.                                    }
{ Modified June 11, 1989, to use Toolbox file calls.                                                }
{ Modified June 15, 1989, to use Tabby Setup name for 'BBS' string.                        }
{ Modified July 22, 1989, for additional error checking.                                        }
{ Modified Nov. 19, 1989, to add WaitNextEvent delay for MultiFinder                    }
{ Modified Jan. 20, 1990, to include all variable declarations necessary --            }
{                        this unit uses no external globals.                                                    }
{ Modified Mar. 03, 1990, to use Tabby Setup file rather than Config file for            }
{                        info re: MF, BBSName etc. This allows Mansion                                }
{                        compatibility.                                                                                }
{ Modified June 16, 1991, to record default path and some other subtle changes.    }
{ Modified June 22, 1991, to make backup of launch.next file in case of error.        }
{ Modified Feb. 07, 1992, to add LogThis function and GetDateAndTime procedure. }

{ This source code is being made public in the hopes that it will lead to more            }
{ and better Tabby applications. I ask only that you credit me with a thanks            }
{ if you incorporate any or all of this code in an application. If you improve            }
{ on this code, please share your ideas.                                                                    }

{ If you're not using Think Pascal, you're on your own. I'm sure someone                }
{ other than me can help you if you need to convert this code for Turbo, TML            }
{ or Apple's MPW Pascal.                                                                                        }

{ Thanks to Erik Selberg, who has been a real help.                                                    }

{ How to use this code:                                                                                            }

{  <1> Create a Think Pascal Project                                                                        }
{  <2> Add the HelloTabby.p file as the first unit                                                        }
{  <3> Create your own additional files                                                                    }

{ You should include an STR  resource 500 in the Project: this holds the name            }
{ of the default launch.next application (usually the BBS application).                        }

{   Your main program Unit should include the following lines at its start:                }

{     uses                                                                                                                }
{       HelloTabby;                                                                                                    }

{   Begin the main procedure of your program as follows:                                        }

{    HelloTabby;                                                                                                        }

{   End the main procedure of your program as follows:                                            }

{    if NextLaunch <> '' then                                                                                    }
{       LaunchNextAppl                                                                                            }
{    end.                                                                                                                    }

{    The following global variables are available to your program:                            }

{    NextLaunch: STR255;        --    Name of next app to launch, empty if none.                }
{    MultiFinder: boolean;            --    True if Tabby Config says MF, else false.                }
{    Err: OSErr;                        --    General variable you can use for OSErrs.                }
{    vRefNum: integer;                --    Reference number of default volume.                        }
{    dirID: longint;                    --    Reference number of default directory.                    }
{    gDefaultpath: str255            --    Full path to default dir (ends w/colon).                    }
{    gVolName: STR255;            --    Name of default volume.                                        }
{    BBSName: STR255;            --    Name of BBS application                                        }
{    BaudString: STR255;        --    Baud rate from Tabby Setup in ASCII                        }
{    PortString: STR255;            --    'a' = modem, 'b' = printer                                        }

interface

    type
        pLaunchStruct = ^LaunchStruct;
        LaunchStruct = record
                pfName: StringPtr;
                param: INTEGER;
                LC: packed array[0..1] of CHAR;    {    extended parameters:                                    }
                extBlockLen: LONGINT;                         {    number of bytes in extension = 6                    }
                fFlags: INTEGER;                                {    Finder file info flags                                        }
                launchFlags: LONGINT;                         {    bit 31,30=1 for sublaunch, others reserved    }
            end;                                                     {    LaunchStruct                                                    }

    const
        sleep = 10;
        Format = 0;

    var
        NextLaunch, gVolName, BBSName, BaudString, PortString, gDefaultpath: STR255;
        MultiFinder: boolean;
        Err: OSErr;
        dirID: longint;
        vRefNum: integer;
        IgnoreBool: boolean;                {    These variables for WaitNextEvent calls    }
        TabbyEventRec: EventRecord;

    function PathNameFromDirID (DirID: longint; vRefNum: integer): str255;

    procedure LaunchNextAppl;

    procedure HelloTabby;

    procedure ReadTabbyConfig;

    procedure GetDateAndTime (var DateTime: str255);
    { returns 'mm/dd/yy hh:mm:ss'}

    function ReadALine (FileRefNum: integer; var TheMessage: string): OSErr;    {very useful!}

    function LogThis (ProgName, StringToLog: string): OSErr;
     { LogThis logs a string into the Tabby Log for your application        }
     { in the form 'mm/dd/yy hh:mm:ss ProgName - StringToLog'        }


implementation

{-----------------------------------------------------------------    }

    function Int2Char (Number: integer): char;

{ Function changes integer to character.                                  }

    begin
        Int2Char := chr(Number + ord('0'));
    end;

{ ------------------------------------------------------ }

    function BigString (Number: integer): string;

{ Function changes two-digit number to a two-character string.           }

    begin
        BigString := concat(Int2Char(Number div 10), Int2Char(Number mod 10));
    end;

{ ------------------------------------------------------ }

    procedure GetDateAndTime; {(VAR DateTime: Str255)}

        var
            dtr: DateTimeRec;

    begin
        GetTime(DTR);
        DateTime := concat(BigString(dtr.Month), '/');
        DateTime := concat(DateTime, BigString(dtr.Day), '/');
        DateTime := concat(DateTime, BigString(dtr.Year - 1900));
        DateTime := concat(DateTime, ' ', BigString(dtr.Hour), ':');
        DateTime := concat(DateTime, BigString(dtr.Minute), ':');
        DateTime := concat(DateTime, BigString(dtr.Second))
    end;

{ ------------------------------------------------------ }

    function LogThis; {(ProgName, StringToLog: STRING): OSErr}

        var
            StrLen: longint;
            LogString: string;
            LogPath, TheDate: Str255;
            fndrInfo: FInfo;
            TLRefNum: integer;

    begin
        LogPath := concat(gDefaultPath, 'Tabby:Tabby Log');
        Err := GetFInfo(LogPath, vRefNum, fndrInfo);
        if Err = FNFErr then
            Err := Create(LogPath, vRefNum, 'QED1', 'TEXT');

        if Err = NoErr then
            Err := FSOpen(LogPath, vRefNum, TLRefNum);

        if Err = NoErr then
            begin
                GetDateAndTime(TheDate);
                LogString := concat(TheDate, ' ', ProgName, ' - ', StringToLog, chr(13));
                StrLen := longint(length(LogString));
                Err := SetFPos(TLRefNum, FSFromLEOF, 0);
                if Err = NoErr then
                    Err := FSWrite(TLRefNum, StrLen, @LogString[1])
            end;
        LogThis := Err;
        Err := FSClose(TLRefNum)
    end;

{ ------------------------------------------------------ }

    function ReadALine;        {    (FileRefNum: integer; var TheMessage: string): OSErr;    }

        var
            myPB: ParamBlockRec;
            myString: Str255;

    begin
        myString := '';
        myPB.ioCompletion := nil;
        myPB.ioRefNum := FileRefNum;
        myPB.ioBuffer := Pointer(@myString[1]);
        myPB.ioReqCount := 255;
        myPB.ioPosMode := 3456; {ASCII 13*256+128}
        myPB.ioPosOffset := 0; {ignored}
        ReadALine := PBRead(@myPB, False);
        if (myString[myPB.ioActCount] = chr(13)) then
            myString[0] := char(myPB.ioActCount - 1) {Drop CR}
        else
            myString[0] := char(myPB.ioActCount);
        TheMessage := myString
    end;

{-----------------------------------------------------------------    }

    procedure ReadTabbyConfig;

        var
            ConfigRefNum, MFCount: integer;
            OneLine: str255;

    begin
        Err := FSOpen(concat(gDefaultpath, 'Tabby:Tabby Setup'), vRefNum, ConfigRefNum);
        if Err = noErr then
            begin
                Err := ReadALine(ConfigRefNum, BBSName);    {    Name of BBS application        }
                Err := ReadALine(ConfigRefNum, OneLine);    {    MF status: 1 true, 0 false        }
                if OneLine[1] = '1' then
                    begin
                        MultiFinder := true;
    {    We now have a valid boolean value for MultiFinder, so let's yield time if appropriate.    }
    {    10 ticks (1/6 sec) times 20 = 3.2 seconds -- same value Michael Connick uses.            }
                        for MFCount := 1 to 20 do
                            IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil)
                    end
                else
                    MultiFinder := false;
                Err := ReadALine(ConfigRefNum, BaudString);    {    Baud rate in ASCII                }
                Err := ReadALine(ConfigRefNum, PortString)        {    'a' = modem, 'b' = printer    }
            end;        {    if Err = noErr    }
        Err := FSClose(ConfigRefNum)
    end;

{ ------------------------------------------------------ }

    function Launchit (pLnch: pLaunchStruct): OSErr;

    inline
        $205F, $A9F2, $3E80;

{ ------------------------------------------------------ }

    procedure LaunchNextAppl;

        var
            pMyLaunch: pLaunchStruct;
            myLaunch: LaunchStruct;
            MyPB: CInfoPBRec;
            MFCount: integer;

    begin

        with MyPB do
            begin
                ioNamePtr := @NextLaunch;
                ioVRefNum := vRefNum;
                ioFDirIndex := 0;
                ioDirID := 0;
            end;    {    with    }
        Err := PBGetCatInfo(@MyPB, false);

        pMyLaunch := @myLaunch;
        with pMyLaunch^ do
            begin
                pfName := @NextLaunch;
                param := 0;
                LC[0] := 'L';
                LC[1] := 'C';
                extBlockLen := 6;
                fFlags := myPB.ioFlFndrInfo.fdFlags;
                if MultiFinder then
                    LaunchFlags := $C0000000            {    set BOTH high bits for a sublaunch        }
                else
                    LaunchFlags := $00000000;        {    just launch, then quit                            }
            end;                                                {    with pMyLaunch^                                }
        if MultiFinder then
            for MFCount := 1 to 20 do
                IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);    {    Give away more cycles    }
        Err := Launchit(pMyLaunch)
    end;

{ ------------------------------------------------------ }

    function PathNameFromDirID;{ (DirID: longint; vRefNum: integer): str255}

        var
            Block: CInfoPBRec;
            directoryName, FullPathName: str255;

    begin
        FullPathName := '';
        with Block do
            begin
                ioNamePtr := @directoryName;
                ioDrParID := DirID
            end;

        repeat
            with Block do
                begin
                    ioVRefNum := vRefNum;
                    ioFDirIndex := -1;
                    ioDrDirID := Block.ioDrParID
                end;
            err := PBGetCatInfo(@Block, FALSE);

            directoryName := concat(directoryName, ':');
            FullPathName := concat(directoryName, FullPathName)
        until (Block.ioDrDirID = fsRtDirID);

        PathNameFromDirID := FullPathName
    end;

{ ------------------------------------------------------ }

    procedure HelloTabby;

{ This procedure looks for a Tabby launch.next file. If it's found, it                 }
{ extracts the events, which are comma delimited, saves the first one            }
{ for the next launch and rewrites the file from event #2 to the last                }
{ event.                                                                                                            }

{ If it finds only one event, it kills the launch.next file.                                   }

{ If there are no events, it returns the application name contained in                }
{ STR  500 as STR255 NextLaunch, otherwise it uses NextLaunch to hold          }
{ the first entry in the launch.next script.                                                         }

{ Before returning, it also checks that the NextLaunch application exists        }
{ by trying to open it. If the open attempt fails, it returns NextLaunch            }
{ as an empty string.                                                                                        }

        type
            HundredEvents = array[1..100] of string[32];
            ManyChars = packed array[1..3300] of char;    {    Can hold 100 32-length events, commas and one <CR>    }

        var
            EventCounter, EventLimit, LNRefNum, LaunchCount: integer;
            LNChar: char;
            TheChars: ManyChars;
            Event: HundredEvents;
            Events, ThisEvent, TempString, BBSName: STR255;
            logicalEOF, Quantity, CharIndex: longint;
            CharCount, SetUpRef, SetUpCount: integer;
            fndrInfo: FInfo;

    begin
        SetCursor(GetCursor(WatchCursor)^^);
        Err := HGetVol(@gVolName, vRefNum, dirID);        { Get volume ref # & dirID for default volume    }
        gDefaultpath := PathNameFromDirID(dirID, vRefNum);    { Get full pathname                            }
        Events := '';
        for EventCounter := 1 to 100 do
            Event[EventCounter] := '';
        ThisEvent := '';
        LNChar := chr(255);                            {    Dummy value so we can spot this first time through    }
        NextLaunch := GetString(500)^^;        {    Get next launch string from resource                            }
        ReadTabbyConfig;                                {    See if we're running MultiFinder & yield time if so        }
        EventCounter := 1;
        Err := FSOpen(concat(gDefaultpath, 'launch.next'), vRefNum, LNRefNum);
        Err := GetEOF(LNRefNum, logicalEOF);
        if (logicalEOF > 0) and (Err = NoErr) then
            begin
                Err := SetFPos(LNRefNum, fsFromStart, 0);
                LaunchCount := 0;
                while (LNChar <> chr(13)) & (LaunchCount <= logicalEOF) do
                    begin
                        if MultiFinder then
                            IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
                        while (LNChar <> ',') & (LNChar <> chr(13)) & (LaunchCount <= logicalEOF) do
                            begin
                                if (LNChar <> chr(255)) then
                                    ThisEvent := concat(ThisEvent, LNChar);
                                LaunchCount := LaunchCount + 1;
                                Quantity := 1;
                                Err := FSRead(LNRefNum, Quantity, @LNChar);
                                LNChar := chr(ord(LNChar) div 256);
                            end;            { (LNChar <> ',') & (LNChar <> chr(13)) & (LaunchCount <= logicalEOF) }
                        Event[EventCounter] := ThisEvent;
                        EventCounter := EventCounter + 1;
                        ThisEvent := '';
                        LNChar := chr(255)
                    end;            { (LNChar <> chr(13)) & (LaunchCount <= logicalEOF) }
                Err := FSClose(LNRefNum);
                Err := FSDelete(concat(gDefaultpath, 'launch.next'), vRefNum);
                EventLimit := (EventCounter - 2);
                if EventLimit > 1 then
                    begin
                        Err := Create(concat(gDefaultpath, 'launch.next'), vRefNum, 'QED1', 'TEXT');
                        Err := FSOpen(concat(gDefaultpath, 'launch.next'), vRefNum, LNRefNum);
                        Err := SetFPos(LNRefNum, fsFromStart, 0);
                        CharIndex := 0;
                        for EventCounter := 2 to EventLimit do
                            begin
                                if MultiFinder then
                                    IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
                                TempString := Event[EventCounter];
                                for CharCount := 1 to length(TempString) do
                                    TheChars[CharIndex + CharCount] := TempString[CharCount];
                                CharIndex := CharIndex + length(TempString) + 1;
                                if EventCounter <> EventLimit then
                                    TheChars[CharIndex] := ','
                                else
                                    TheChars[CharIndex] := chr(13)
                            end; {Counter loop}
                        Err := FSWrite(LNRefNum, CharIndex, @TheChars);
                        Err := FSClose(LNRefNum);
                        Err := FlushVol(@gVolName, vRefNum)
                    end; {EventLimit > 1}
                if EventLimit > 0 then
                    NextLaunch := Event[1];
                TempString := NextLaunch;
                UprString(TempString, false);
                if TempString = 'BBS' then
                    begin
                        Err := FSOpen(concat(gDefaultpath, 'Tabby:Tabby Setup'), vRefNum, SetupRef);
                        if Err = NoErr then
                            Err := GetEOF(SetupRef, logicalEOF);
                        if (logicalEOF > 0) & (Err = NoErr) then
                            begin
                                Err := ReadALine(LNRefNum, NextLaunch);
                                Err := FSClose(SetupRef);
                            end        {    if logicalEOF > 0 for 'Tabby Setup'    }
                    end;        {    if TempString = 'BBS'     }
            end        {    if logicalEOF > 0 for 'launch.next'    }
        else
            begin
                Err := FSClose(LNRefNum);
                Err := FSDelete(concat(gDefaultpath, 'launch.next.bak'), vRefNum);
                Err := Rename(concat(gDefaultpath, 'launch.next'), vRefNum, concat(gDefaultpath, 'launch.next.bak'))
            end;
        Err := GetFInfo(NextLaunch, vRefNum, fndrInfo);    {    Is it an application?    }
        if (Err <> noErr) | (fndrInfo.fdType <> 'APPL') then
            NextLaunch := '';
        if MultiFinder then
            IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil)
    end;            { HelloTabby procedure }
end.                { Unit }